/*
** $Id: ldebug.c,v 2.121 2016/10/19 12:32:10 roberto Exp $
** Debug Interface
** See Copyright Notice in lua.h
*/

#define ldebug_c
#define LUA_CORE

#include "lprefix.h"


#include <stdarg.h>
#include <stddef.h>
#include <string.h>

#include "lua.h"

#include "lapi.h"
#include "lcode.h"
#include "ldebug.h"
#include "ldo.h"
#include "lfunc.h"
#include "lobject.h"
#include "lopcodes.h"
#include "lstate.h"
#include "lstring.h"
#include "ltable.h"
#include "ltm.h"
#include "lvm.h"



#define noLuaClosure(f)     ((f) == NULL || (f)->c.tt == LUA_TCCL)


/* Active Lua function (given call info) */
#define ci_func(ci)     (clLvalue((ci)->func))


static const char* funcnamefromcode( lua_State* L, CallInfo* ci,
                                     const char** name );


static int currentpc( CallInfo* ci ) {
    lua_assert( isLua( ci ) );
    return pcRel( ci->u.l.savedpc, ci_func( ci )->p );
}


static int currentline( CallInfo* ci ) {
    return getfuncline( ci_func( ci )->p, currentpc( ci ) );
}


/*
** If function yielded, its 'func' can be in the 'extra' field. The
** next function restores 'func' to its correct value for debugging
** purposes. (It exchanges 'func' and 'extra'; so, when called again,
** after debugging, it also "re-restores" ** 'func' to its altered value.
*/
static void swapextra( lua_State* L ) {
    if ( L->status == LUA_YIELD ) {
        CallInfo* ci = L->ci;  /* get function that yielded */
        StkId temp = ci->func;  /* exchange its 'func' and 'extra' values */
        ci->func = restorestack( L, ci->extra );
        ci->extra = savestack( L, temp );
    }
}


/*
** This function can be called asynchronously (e.g. during a signal).
** Fields 'oldpc', 'basehookcount', and 'hookcount' (set by
** 'resethookcount') are for debug only, and it is no problem if they
** get arbitrary values (causes at most one wrong hook call). 'hookmask'
** is an atomic value. We assume that pointers are atomic too (e.g., gcc
** ensures that for all platforms where it runs). Moreover, 'hook' is
** always checked before being called (see 'luaD_hook').
*/
LUA_API void lua_sethook( lua_State* L, lua_Hook func, int mask, int count ) {
    if ( func == NULL || mask == 0 ) { /* turn off hooks? */
        mask = 0;
        func = NULL;
    }

    if ( isLua( L->ci ) ) {
        L->oldpc = L->ci->u.l.savedpc;
    }

    L->hook = func;
    L->basehookcount = count;
    resethookcount( L );
    L->hookmask = cast_byte( mask );
}


LUA_API lua_Hook lua_gethook( lua_State* L ) {
    return L->hook;
}


LUA_API int lua_gethookmask( lua_State* L ) {
    return L->hookmask;
}


LUA_API int lua_gethookcount( lua_State* L ) {
    return L->basehookcount;
}


LUA_API int lua_getstack( lua_State* L, int level, lua_Debug* ar ) {
    int status;
    CallInfo* ci;

    if ( level < 0 ) {
        return 0;    /* invalid (negative) level */
    }

    lua_lock( L );

    for ( ci = L->ci; level > 0 && ci != &L->base_ci; ci = ci->previous ) {
        level--;
    }

    if ( level == 0 && ci != &L->base_ci ) { /* level found? */
        status = 1;
        ar->i_ci = ci;
    }
    else {
        status = 0;    /* no such level */
    }

    lua_unlock( L );
    return status;
}


static const char* upvalname( Proto* p, int uv ) {
    TString* s = check_exp( uv < p->sizeupvalues, p->upvalues[uv].name );

    if ( s == NULL ) {
        return "?";
    }
    else {
        return getstr( s );
    }
}


static const char* findvararg( CallInfo* ci, int n, StkId* pos ) {
    int nparams = clLvalue( ci->func )->p->numparams;

    if ( n >= cast_int( ci->u.l.base - ci->func ) - nparams ) {
        return NULL;    /* no such vararg */
    }
    else {
        *pos = ci->func + nparams + n;
        return "(*vararg)";  /* generic name for any vararg */
    }
}


static const char* findlocal( lua_State* L, CallInfo* ci, int n,
                              StkId* pos ) {
    const char* name = NULL;
    StkId base;

    if ( isLua( ci ) ) {
        if ( n < 0 ) { /* access to vararg values? */
            return findvararg( ci, -n, pos );
        }
        else {
            base = ci->u.l.base;
            name = luaF_getlocalname( ci_func( ci )->p, n, currentpc( ci ) );
        }
    }
    else {
        base = ci->func + 1;
    }

    if ( name == NULL ) { /* no 'standard' name? */
        StkId limit = ( ci == L->ci ) ? L->top : ci->next->func;

        if ( limit - base >= n && n > 0 ) { /* is 'n' inside 'ci' stack? */
            name = "(*temporary)";    /* generic name for any valid slot */
        }
        else {
            return NULL;    /* no name */
        }
    }

    *pos = base + ( n - 1 );
    return name;
}


LUA_API const char* lua_getlocal( lua_State* L, const lua_Debug* ar, int n ) {
    const char* name;
    lua_lock( L );
    swapextra( L );

    if ( ar == NULL ) { /* information about non-active function? */
        if ( !isLfunction( L->top - 1 ) ) { /* not a Lua function? */
            name = NULL;
        }
        else { /* consider live variables at function start (parameters) */
            name = luaF_getlocalname( clLvalue( L->top - 1 )->p, n, 0 );
        }
    }
    else {   /* active function; get information through 'ar' */
        StkId pos = NULL;  /* to avoid warnings */
        name = findlocal( L, ar->i_ci, n, &pos );

        if ( name ) {
            setobj2s( L, L->top, pos );
            api_incr_top( L );
        }
    }

    swapextra( L );
    lua_unlock( L );
    return name;
}


LUA_API const char* lua_setlocal( lua_State* L, const lua_Debug* ar, int n ) {
    StkId pos = NULL;  /* to avoid warnings */
    const char* name;
    lua_lock( L );
    swapextra( L );
    name = findlocal( L, ar->i_ci, n, &pos );

    if ( name ) {
        setobjs2s( L, pos, L->top - 1 );
        L->top--;  /* pop value */
    }

    swapextra( L );
    lua_unlock( L );
    return name;
}


static void funcinfo( lua_Debug* ar, Closure* cl ) {
    if ( noLuaClosure( cl ) ) {
        ar->source = "=[C]";
        ar->linedefined = -1;
        ar->lastlinedefined = -1;
        ar->what = "C";
    }
    else {
        Proto* p = cl->l.p;
        ar->source = p->source ? getstr( p->source ) : "=?";
        ar->linedefined = p->linedefined;
        ar->lastlinedefined = p->lastlinedefined;
        ar->what = ( ar->linedefined == 0 ) ? "main" : "Lua";
    }

    luaO_chunkid( ar->short_src, ar->source, LUA_IDSIZE );
}


static void collectvalidlines( lua_State* L, Closure* f ) {
    if ( noLuaClosure( f ) ) {
        setnilvalue( L->top );
        api_incr_top( L );
    }
    else {
        int i;
        TValue v;
        int* lineinfo = f->l.p->lineinfo;
        Table* t = luaH_new( L ); /* new table to store active lines */
        sethvalue( L, L->top, t ); /* push it on stack */
        api_incr_top( L );
        setbvalue( &v, 1 ); /* boolean 'true' to be the value of all indices */

        for ( i = 0; i < f->l.p->sizelineinfo; i++ ) { /* for all lines with code */
            luaH_setint( L, t, lineinfo[i], &v );    /* table[line] = true */
        }
    }
}


static const char* getfuncname( lua_State* L, CallInfo* ci,
                                const char** name ) {
    if ( ci == NULL ) { /* no 'ci'? */
        return NULL;    /* no info */
    }
    else if ( ci->callstatus & CIST_FIN ) { /* is this a finalizer? */
        *name = "__gc";
        return "metamethod";  /* report it as such */
    }
    /* calling function is a known Lua function? */
    else if ( !( ci->callstatus & CIST_TAIL ) && isLua( ci->previous ) ) {
        return funcnamefromcode( L, ci->previous, name );
    }
    else {
        return NULL;    /* no way to find a name */
    }
}


static int auxgetinfo( lua_State* L, const char* what, lua_Debug* ar,
                       Closure* f, CallInfo* ci ) {
    int status = 1;

    for ( ; *what; what++ ) {
        switch ( *what ) {
        case 'S': {
            funcinfo( ar, f );
            break;
        }

        case 'l': {
            ar->currentline = ( ci && isLua( ci ) ) ? currentline( ci ) : -1;
            break;
        }

        case 'u': {
            ar->nups = ( f == NULL ) ? 0 : f->c.nupvalues;

            if ( noLuaClosure( f ) ) {
                ar->isvararg = 1;
                ar->nparams = 0;
            }
            else {
                ar->isvararg = f->l.p->is_vararg;
                ar->nparams = f->l.p->numparams;
            }

            break;
        }

        case 't': {
            ar->istailcall = ( ci ) ? ci->callstatus & CIST_TAIL : 0;
            break;
        }

        case 'n': {
            ar->namewhat = getfuncname( L, ci, &ar->name );

            if ( ar->namewhat == NULL ) {
                ar->namewhat = "";  /* not found */
                ar->name = NULL;
            }

            break;
        }

        case 'L':
        case 'f':  /* handled by lua_getinfo */
            break;

        default:
            status = 0;  /* invalid option */
        }
    }

    return status;
}


LUA_API int lua_getinfo( lua_State* L, const char* what, lua_Debug* ar ) {
    int status;
    Closure* cl;
    CallInfo* ci;
    StkId func;
    lua_lock( L );
    swapextra( L );

    if ( *what == '>' ) {
        ci = NULL;
        func = L->top - 1;
        api_check( L, ttisfunction( func ), "function expected" );
        what++;  /* skip the '>' */
        L->top--;  /* pop function */
    }
    else {
        ci = ar->i_ci;
        func = ci->func;
        lua_assert( ttisfunction( ci->func ) );
    }

    cl = ttisclosure( func ) ? clvalue( func ) : NULL;
    status = auxgetinfo( L, what, ar, cl, ci );

    if ( strchr( what, 'f' ) ) {
        setobjs2s( L, L->top, func );
        api_incr_top( L );
    }

    swapextra( L ); /* correct before option 'L', which can raise a mem. error */

    if ( strchr( what, 'L' ) ) {
        collectvalidlines( L, cl );
    }

    lua_unlock( L );
    return status;
}


/*
** {======================================================
** Symbolic Execution
** =======================================================
*/

static const char* getobjname( Proto* p, int lastpc, int reg,
                               const char** name );


/*
** find a "name" for the RK value 'c'
*/
static void kname( Proto* p, int pc, int c, const char** name ) {
    if ( ISK( c ) ) { /* is 'c' a constant? */
        TValue* kvalue = &p->k[INDEXK( c )];

        if ( ttisstring( kvalue ) ) { /* literal constant? */
            *name = svalue( kvalue ); /* it is its own name */
            return;
        }

        /* else no reasonable name found */
    }
    else {   /* 'c' is a register */
        const char* what = getobjname( p, pc, c, name ); /* search for 'c' */

        if ( what && *what == 'c' ) { /* found a constant name? */
            return;  /* 'name' already filled */
        }

        /* else no reasonable name found */
    }

    *name = "?";  /* no reasonable name found */
}


static int filterpc( int pc, int jmptarget ) {
    if ( pc < jmptarget ) { /* is code conditional (inside a jump)? */
        return -1;    /* cannot know who sets that register */
    }
    else {
        return pc;    /* current position sets that register */
    }
}


/*
** try to find last instruction before 'lastpc' that modified register 'reg'
*/
static int findsetreg( Proto* p, int lastpc, int reg ) {
    int pc;
    int setreg = -1;  /* keep last instruction that changed 'reg' */
    int jmptarget = 0;  /* any code before this address is conditional */

    for ( pc = 0; pc < lastpc; pc++ ) {
        Instruction i = p->code[pc];
        OpCode op = GET_OPCODE( i );
        int a = GETARG_A( i );

        switch ( op ) {
        case OP_LOADNIL: {
            int b = GETARG_B( i );

            if ( a <= reg && reg <= a + b ) { /* set registers from 'a' to 'a+b' */
                setreg = filterpc( pc, jmptarget );
            }

            break;
        }

        case OP_TFORCALL: {
            if ( reg >= a + 2 ) { /* affect all regs above its base */
                setreg = filterpc( pc, jmptarget );
            }

            break;
        }

        case OP_CALL:
        case OP_TAILCALL: {
            if ( reg >= a ) { /* affect all registers above base */
                setreg = filterpc( pc, jmptarget );
            }

            break;
        }

        case OP_JMP: {
            int b = GETARG_sBx( i );
            int dest = pc + 1 + b;

            /* jump is forward and do not skip 'lastpc'? */
            if ( pc < dest && dest <= lastpc ) {
                if ( dest > jmptarget ) {
                    jmptarget = dest;    /* update 'jmptarget' */
                }
            }

            break;
        }

        default:
            if ( testAMode( op ) && reg == a ) { /* any instruction that set A */
                setreg = filterpc( pc, jmptarget );
            }

            break;
        }
    }

    return setreg;
}


static const char* getobjname( Proto* p, int lastpc, int reg,
                               const char** name ) {
    int pc;
    *name = luaF_getlocalname( p, reg + 1, lastpc );

    if ( *name ) { /* is a local? */
        return "local";
    }

    /* else try symbolic execution */
    pc = findsetreg( p, lastpc, reg );

    if ( pc != -1 ) { /* could find instruction? */
        Instruction i = p->code[pc];
        OpCode op = GET_OPCODE( i );

        switch ( op ) {
        case OP_MOVE: {
            int b = GETARG_B( i ); /* move from 'b' to 'a' */

            if ( b < GETARG_A( i ) ) {
                return getobjname( p, pc, b, name );    /* get name for 'b' */
            }

            break;
        }

        case OP_GETTABUP:
        case OP_GETTABLE: {
            int k = GETARG_C( i ); /* key index */
            int t = GETARG_B( i ); /* table index */
            const char* vn = ( op == OP_GETTABLE ) /* name of indexed variable */
                             ? luaF_getlocalname( p, t + 1, pc )
                             : upvalname( p, t );
            kname( p, pc, k, name );
            return ( vn && strcmp( vn, LUA_ENV ) == 0 ) ? "global" : "field";
        }

        case OP_GETUPVAL: {
            *name = upvalname( p, GETARG_B( i ) );
            return "upvalue";
        }

        case OP_LOADK:
        case OP_LOADKX: {
            int b = ( op == OP_LOADK ) ? GETARG_Bx( i )
                    : GETARG_Ax( p->code[pc + 1] );

            if ( ttisstring( &p->k[b] ) ) {
                *name = svalue( &p->k[b] );
                return "constant";
            }

            break;
        }

        case OP_SELF: {
            int k = GETARG_C( i ); /* key index */
            kname( p, pc, k, name );
            return "method";
        }

        default:
            break;  /* go through to return NULL */
        }
    }

    return NULL;  /* could not find reasonable name */
}


/*
** Try to find a name for a function based on the code that called it.
** (Only works when function was called by a Lua function.)
** Returns what the name is (e.g., "for iterator", "method",
** "metamethod") and sets '*name' to point to the name.
*/
static const char* funcnamefromcode( lua_State* L, CallInfo* ci,
                                     const char** name ) {
    TMS tm = ( TMS )0; /* (initial value avoids warnings) */
    Proto* p = ci_func( ci )->p; /* calling function */
    int pc = currentpc( ci ); /* calling instruction index */
    Instruction i = p->code[pc];  /* calling instruction */

    if ( ci->callstatus & CIST_HOOKED ) { /* was it called inside a hook? */
        *name = "?";
        return "hook";
    }

    switch ( GET_OPCODE( i ) ) {
    case OP_CALL:
    case OP_TAILCALL:
        return getobjname( p, pc, GETARG_A( i ), name ); /* get function name */

    case OP_TFORCALL: {  /* for iterator */
        *name = "for iterator";
        return "for iterator";
    }

    /* other instructions can do calls through metamethods */
    case OP_SELF:
    case OP_GETTABUP:
    case OP_GETTABLE:
        tm = TM_INDEX;
        break;

    case OP_SETTABUP:
    case OP_SETTABLE:
        tm = TM_NEWINDEX;
        break;

    case OP_ADD:
    case OP_SUB:
    case OP_MUL:
    case OP_MOD:
    case OP_POW:
    case OP_DIV:
    case OP_IDIV:
    case OP_BAND:
    case OP_BOR:
    case OP_BXOR:
    case OP_SHL:
    case OP_SHR: {
        int offset = cast_int( GET_OPCODE( i ) ) - cast_int( OP_ADD ); /* ORDER OP */
        tm = cast( TMS, offset + cast_int( TM_ADD ) ); /* ORDER TM */
        break;
    }

    case OP_UNM:
        tm = TM_UNM;
        break;

    case OP_BNOT:
        tm = TM_BNOT;
        break;

    case OP_LEN:
        tm = TM_LEN;
        break;

    case OP_CONCAT:
        tm = TM_CONCAT;
        break;

    case OP_EQ:
        tm = TM_EQ;
        break;

    case OP_LT:
        tm = TM_LT;
        break;

    case OP_LE:
        tm = TM_LE;
        break;

    default:
        return NULL;  /* cannot find a reasonable name */
    }

    *name = getstr( G( L )->tmname[tm] );
    return "metamethod";
}

/* }====================================================== */



/*
** The subtraction of two potentially unrelated pointers is
** not ISO C, but it should not crash a program; the subsequent
** checks are ISO C and ensure a correct result.
*/
static int isinstack( CallInfo* ci, const TValue* o ) {
    ptrdiff_t i = o - ci->u.l.base;
    return ( 0 <= i && i < ( ci->top - ci->u.l.base ) && ci->u.l.base + i == o );
}


/*
** Checks whether value 'o' came from an upvalue. (That can only happen
** with instructions OP_GETTABUP/OP_SETTABUP, which operate directly on
** upvalues.)
*/
static const char* getupvalname( CallInfo* ci, const TValue* o,
                                 const char** name ) {
    LClosure* c = ci_func( ci );
    int i;

    for ( i = 0; i < c->nupvalues; i++ ) {
        if ( c->upvals[i]->v == o ) {
            *name = upvalname( c->p, i );
            return "upvalue";
        }
    }

    return NULL;
}


static const char* varinfo( lua_State* L, const TValue* o ) {
    const char* name = NULL;  /* to avoid warnings */
    CallInfo* ci = L->ci;
    const char* kind = NULL;

    if ( isLua( ci ) ) {
        kind = getupvalname( ci, o, &name ); /* check whether 'o' is an upvalue */

        if ( !kind && isinstack( ci, o ) ) /* no? try a register */
            kind = getobjname( ci_func( ci )->p, currentpc( ci ),
                               cast_int( o - ci->u.l.base ), &name );
    }

    return ( kind ) ? luaO_pushfstring( L, " (%s '%s')", kind, name ) : "";
}


l_noret luaG_typeerror( lua_State* L, const TValue* o, const char* op ) {
    const char* t = luaT_objtypename( L, o );
    luaG_runerror( L, "attempt to %s a %s value%s", op, t, varinfo( L, o ) );
}


l_noret luaG_concaterror( lua_State* L, const TValue* p1, const TValue* p2 ) {
    if ( ttisstring( p1 ) || cvt2str( p1 ) ) {
        p1 = p2;
    }

    luaG_typeerror( L, p1, "concatenate" );
}


l_noret luaG_opinterror( lua_State* L, const TValue* p1,
                         const TValue* p2, const char* msg ) {
    lua_Number temp;

    if ( !tonumber( p1, &temp ) ) { /* first operand is wrong? */
        p2 = p1;    /* now second is wrong */
    }

    luaG_typeerror( L, p2, msg );
}


/*
** Error when both values are convertible to numbers, but not to integers
*/
l_noret luaG_tointerror( lua_State* L, const TValue* p1, const TValue* p2 ) {
    lua_Integer temp;

    if ( !tointeger( p1, &temp ) ) {
        p2 = p1;
    }

    luaG_runerror( L, "number%s has no integer representation", varinfo( L, p2 ) );
}


l_noret luaG_ordererror( lua_State* L, const TValue* p1, const TValue* p2 ) {
    const char* t1 = luaT_objtypename( L, p1 );
    const char* t2 = luaT_objtypename( L, p2 );

    if ( strcmp( t1, t2 ) == 0 ) {
        luaG_runerror( L, "attempt to compare two %s values", t1 );
    }
    else {
        luaG_runerror( L, "attempt to compare %s with %s", t1, t2 );
    }
}


/* add src:line information to 'msg' */
const char* luaG_addinfo( lua_State* L, const char* msg, TString* src,
                          int line ) {
    char buff[LUA_IDSIZE];

    if ( src ) {
        luaO_chunkid( buff, getstr( src ), LUA_IDSIZE );
    }
    else {  /* no source available; use "?" instead */
        buff[0] = '?';
        buff[1] = '\0';
    }

    return luaO_pushfstring( L, "%s:%d: %s", buff, line, msg );
}


l_noret luaG_errormsg( lua_State* L ) {
    if ( L->errfunc != 0 ) { /* is there an error handling function? */
        StkId errfunc = restorestack( L, L->errfunc );
        setobjs2s( L, L->top, L->top - 1 ); /* move argument */
        setobjs2s( L, L->top - 1, errfunc ); /* push function */
        L->top++;  /* assume EXTRA_STACK */
        luaD_callnoyield( L, L->top - 2, 1 ); /* call it */
    }

    luaD_throw( L, LUA_ERRRUN );
}


l_noret luaG_runerror( lua_State* L, const char* fmt, ... ) {
    CallInfo* ci = L->ci;
    const char* msg;
    va_list argp;
    va_start( argp, fmt );
    msg = luaO_pushvfstring( L, fmt, argp ); /* format message */
    va_end( argp );

    if ( isLua( ci ) ) { /* if Lua function, add source:line information */
        luaG_addinfo( L, msg, ci_func( ci )->p->source, currentline( ci ) );
    }

    luaG_errormsg( L );
}


void luaG_traceexec( lua_State* L ) {
    CallInfo* ci = L->ci;
    lu_byte mask = L->hookmask;
    int counthook = ( --L->hookcount == 0 && ( mask & LUA_MASKCOUNT ) );

    if ( counthook ) {
        resethookcount( L );    /* reset count */
    }
    else if ( !( mask & LUA_MASKLINE ) ) {
        return;    /* no line hook and count != 0; nothing to be done */
    }

    if ( ci->callstatus & CIST_HOOKYIELD ) { /* called hook last time? */
        ci->callstatus &= ~CIST_HOOKYIELD;  /* erase mark */
        return;  /* do not call hook again (VM yielded, so it did not move) */
    }

    if ( counthook ) {
        luaD_hook( L, LUA_HOOKCOUNT, -1 );    /* call count hook */
    }

    if ( mask & LUA_MASKLINE ) {
        Proto* p = ci_func( ci )->p;
        int npc = pcRel( ci->u.l.savedpc, p );
        int newline = getfuncline( p, npc );

        if ( npc == 0 || /* call linehook when enter a new function, */
                ci->u.l.savedpc <= L->oldpc ||  /* when jump back (loop), or when */
                newline != getfuncline( p, pcRel( L->oldpc, p ) ) ) { /* enter a new line */
            luaD_hook( L, LUA_HOOKLINE, newline );    /* call line hook */
        }
    }

    L->oldpc = ci->u.l.savedpc;

    if ( L->status == LUA_YIELD ) { /* did hook yield? */
        if ( counthook ) {
            L->hookcount = 1;    /* undo decrement to zero */
        }

        ci->u.l.savedpc--;  /* undo increment (resume will increment it again) */
        ci->callstatus |= CIST_HOOKYIELD;  /* mark that it yielded */
        ci->func = L->top - 1;  /* protect stack below results */
        luaD_throw( L, LUA_YIELD );
    }
}

